home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / aplibs91.zip / MENUS-U.BAS < prev    next >
BASIC Source File  |  1991-07-02  |  21KB  |  631 lines
  1.  
  2.  
  3. '==============================================================================
  4. '                        ALL-PURPOSE LIBRARY
  5.  
  6. '                     THE NEW IMPROVED MENUS-U.BAS
  7. '==============================================================================
  8. '                                                               -- 2-18-90
  9. '                                                                  H Ballinger
  10.                             $COMPILE UNIT
  11.                             $ERROR ALL OFF
  12.                             $OPTION AUTODIM ON
  13.                             DEFINT A-Z
  14.  
  15.  EXTERNAL RD$, VideoSeg&, ColorDisplay, NeedDCon
  16.  EXTERNAL BoxColor, FldColor, WinColor, MenuColor, BarColor, ScrColor
  17.  EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
  18.  EXTERNAL ButtonActive, TimeOut, Key2Alt ()
  19.  EXTERNAL Escapable, UsingButtons, TopOfButtons
  20.  EXTERNAL MenuHelpLine$() , mm$()
  21.  EXTERNAL UseRArrow, UseLArrow, UsePgUp, UsePgDn, PullDown
  22.  EXTERNAL LBPresses, LBReleases, LeftButtonPressed
  23.  EXTERNAL RightButtonPressed, MouseLin, MouseCol, ExtraButton
  24.  
  25.  
  26.  DECLARE SUB Marker (string)
  27.  DECLARE SUB SCREENPUSH ()
  28.  DECLARE SUB SCREENPOP ()
  29.  DECLARE SUB QBox (integer,integer,integer,string,integer)
  30.  DECLARE SUB PressAKey ()
  31.  DECLARE SUB ButtonButton ()
  32.  DECLARE SUB GetMouse ()
  33.  DECLARE FUNCTION ButtonIsClick (integer, integer)
  34.  
  35.  
  36.  %False = 0
  37.  %True = NOT %False
  38.  %ButtonsDefined = 0
  39.  
  40.  %ResetRodent = 0 '        mouse routine and humor (??) courtesy of Barry Erick
  41.  %ReadRodent = 3
  42.  %SetRodent = 4
  43.  %CountClicks = 5
  44.  %CountReleases = 6 ' / BX=0  (ON RETURN, BX = NUMBER OF REL) READ INTO BX
  45.  
  46. '-----------------------------------------------------------
  47.  
  48.   %FLAGS = 0:  %AX = 1:  %BX = 2:  %CX = 3:  %DX = 4
  49.      %SI = 5:  %DI = 6:  %BP = 7:  %DS = 8:  %ES = 9
  50.  
  51.  
  52.  %LeftButton = 1
  53.  %RightButton = 2
  54.  %Wht = 15
  55.  %MouseVertSensit = 1 '                   controls mouse sensitivity in POPMENU
  56.  %MouseHorizSensit = 10 '                controls mouse sensitivity in POPMENU
  57.  %MouseIcon = 15 '              ... a little sun or bug character
  58.  
  59.  %MaxMenuWidth = 40
  60.  
  61. '  MENU RETURN CODES (KEY PRESSED.)
  62.       %CR = 0:    %Esc = &H20:          %F1 = &H100:           %F2 = &H200
  63.             %PgUp = &H400:              %PgDn = &H600
  64.             %RArrow = &H800:            %LArrow = &HA00
  65.  
  66.  
  67.  
  68.  DECLARE SUB Mouse (integer, integer, integer, integer)
  69.  
  70.  
  71. ' ----------------------------------------------------------------------------
  72.  
  73. SUB TOPMENU (Lines% ,Choice, TLine$) PUBLIC
  74.  
  75.  LOCAL I$(), K$(), Choices%, D$, LEach, L, SpacesLeftOver, I%, B$, Att,_
  76.   Choice$, Click, Ln, Col, RefTime&, Chr%
  77.  
  78.  STATIC mcsrX, mcsrY
  79.  ButtonActive = 0
  80.  RefTime& = TIMER '                                     look at the clock ...
  81.  
  82.  
  83.  DIM I$(6): DIM K$(6) '                                  read menu lines ...
  84.  Choices% = 0
  85.  
  86.  IF mm$(1) = "" THEN
  87.    READ D$
  88.    DO WHILE D$ <> "END"
  89.      INCR Choices%
  90.      I$(Choices%) = D$
  91.      Chr% = 0
  92.      DO '                                               NEW: The Hot-key will be
  93.        INCR Chr% '                                      the first UPPER-CASE chr
  94.        K$ (Choices%) = MID$ (I$ (Choices%), Chr%, 1) ' in the choice name. E.G.
  95.      LOOP UNTIL K$ (Choices%) =< "Z"  '                 for "eXIT" you press "X".
  96.      READ D$
  97.    LOOP
  98.  ELSE
  99.    DO
  100.      INCR Choices%
  101.      IF mm$ (Choices%) = "" THEN DECR Choices%: EXIT LOOP
  102.      I$ (Choices%) = mm$ (Choices%)
  103.      Chr% = 0
  104.      DO '                                               NEW: The Hot-key will be
  105.        INCR Chr% '                                      the first UPPER-CASE chr
  106.        K$ (Choices%) = MID$ (mm$ (Choices%), Chr%, 1) ' in the choice name; e.g.
  107.      LOOP UNTIL K$ (Choices%) =< "Z"  '                 for "eXit" you press "X".
  108.    LOOP
  109.  END IF
  110.  
  111.  
  112.  LOCATE ,,0
  113.  
  114.  
  115. TSetVars:
  116.  IF Choice = 0 THEN Choice = 1
  117.  LEach = 80\Choices%
  118.  SpacesLeftOver = 80 - Choices% * LEach
  119.  
  120.  FOR I% = 1 TO Choices% '                                create menu elements
  121.   B$ = I$(I%)
  122.   L = ((LEach - LEN(B$))/2) + 1: IF L<2 THEN L=2 '               fixed 12-88
  123.   I$(I%) = SPACE$(LEach)
  124.   MID$ (I$(I%), L) = B$
  125.   IF SpacesLeftOver THEN I$(I%) = I$(I%)+" ": DECR SpacesLeftOver
  126.  NEXT I%
  127. '                                      making their total length = 80 chrs
  128.  DEF SEG = VideoSeg&
  129.  BLAtt = PEEK (3841)
  130.  DEF SEG
  131.  
  132.  COLOR MenuColor MOD 16, MenuColor \ 16
  133.  LOCATE 25,1: PRINT "CHOOSE MAIN PROGRAM FUNCTION FROM TOP ROW.";
  134.                PRINT " USE ARROWS TO SELECT THEN PRESS [CR]";
  135.  DEF SEG = VideoSeg&
  136.  POKE 3998, ASC("."): POKE 3999,PEEK (3997)
  137.  DEF SEG '                                  menu borders & help line printed
  138.  
  139.  LOCATE 1,1
  140.  IF Lines% > 2 THEN PRINT STRING$ (80, 205)
  141.  IF TLine$ <> "" THEN LOCATE 1, (40 - LEN(TLine$)\2): PRINT TLine$;
  142.  TLine$ = ""
  143. TDisp:
  144.  Att = 16
  145.  GOSUB TPrint '                                     print menu elements
  146.  COLOR MenuColor MOD 16, MenuColor \ 16
  147.  IF Lines% > 1 THEN LOCATE 3,1:PRINT STRING$ (80, 205)
  148.  
  149.  IF UsingButtons THEN
  150.    COLOR ScrColor MOD 16, ScrColor \ 16
  151.    CALL ButtonButton
  152.  END IF
  153.  
  154. TGetChoice:
  155.  IF NeedDCon THEN
  156.    Cheese = 0
  157.    Choice$ = ""
  158.    DEF SEG = VideoSeg&
  159.    StoredChr = PEEK (Addr): StoredAttr = PEEK (Addr+1)
  160.    DO
  161.      CALL Mouse (%ReadRodent, Click, mcsrX, mcsrY)
  162.  
  163.      IF Addr <> mcsrX/4 + 160*INT(mcsrY/8) THEN
  164.        POKE Addr, StoredChr
  165.        POKE Addr+1, StoredAttr
  166.        Addr = mcsrX/4 + 160*INT(mcsrY/8)
  167.        StoredChr = PEEK (Addr)
  168.        StoredAttr = PEEK (Addr+1)
  169.        POKE Addr, %MouseIcon '                    move the mouse cursor if nec.
  170.        POKE Addr+1, %Wht OR PEEK (Addr+1)
  171.      END IF
  172.  
  173.      IF (Click = %LeftButton) AND (mcsrY < 60) THEN '   you clicked on top bar:
  174.        Choice = INT (mcsrX * Choices% / 640) + 1  '       so move cursor ...
  175.        Att = 16
  176.        GOSUB TPrint '                                  &  reprint menu elements
  177.        IF mcsrY > 0 AND mcsrY < 30 THEN
  178.          Choice$ = CHR$(13)
  179.          POKE Addr, StoredChr
  180.          POKE Addr+1, StoredAttr
  181.          EXIT LOOP
  182.        END IF
  183.      END IF
  184.  
  185.      IF UsingButtons THEN                        ' ---------------------------|
  186.        IF Click = %LeftButton THEN
  187.          Ln = mcsrY / 8 + 1 '                    8 mickeys per line
  188.          Col = mcsrX / 8 + 1 '                     8 mickeys per column
  189.          ButtonActive = ButtonIsClick (Ln, Col)
  190.        END IF
  191.      END IF                                 ' --------------------------------|
  192.  
  193.      IF ButtonActive THEN EXIT LOOP
  194.  
  195.      IF TimeOut AND (TIMER > RefTime& + TimeOut) THEN
  196.        TimeUp = %True
  197.        EXIT LOOP
  198.      END IF
  199.  
  200.    LOOP UNTIL INSTAT
  201.    IF Choice$ = "" THEN Choice$ = INKEY$
  202.    DEF SEG
  203.  
  204.  ELSE
  205.  
  206.    DO
  207.      IF TimeOut AND (TIMER > RefTime& + TimeOut) THEN
  208.        TimeUp = %True
  209.        EXIT LOOP
  210.      END IF
  211.    LOOP UNTIL INSTAT
  212.  
  213. '                                                         ****************
  214.    Choice$ = INKEY$ '                                   ** GET KEYSTROKE **
  215. '                                                         ****************
  216.  END IF
  217.  
  218.  IF ExtraButton AND Choice$ = CHR$ (9) THEN ButtonActive = 5
  219.  IF TimeUp OR ButtonActive THEN Choice = 1 : GOTO TDone
  220.  IF LEN(Choice$) > 1 THEN '                        you pressed an arrow key ...
  221.    SELECT CASE RIGHT$(Choice$,1)
  222.      CASE CHR$(&H4D)
  223.        GOSUB TRightArrow
  224.      CASE CHR$(&H4B)
  225.        GOSUB TLeftArrow
  226.      CASE CHR$(&H50)
  227.        Choice$ = CHR$(13)
  228.      CASE CHR$(59)
  229.        TLine$ = "HELP!"
  230.        GOTO TDone
  231.      CASE ELSE
  232.        ButtonActive = 0
  233.        IF UsingButtons THEN
  234.          FOR I = LBOUND (Key2Alt(1)) TO UBOUND (Key2Alt(1))
  235.            IF ASCII (RIGHT$ (Choice$, 1)) = Key2Alt (I) THEN
  236.              ButtonActive = I
  237.            END IF
  238.          NEXT I
  239.        END IF
  240.        IF  ButtonActive = 0 THEN
  241.          GOTO TError
  242.        ELSE
  243.          GOTO TDone
  244.        END IF
  245.    END SELECT
  246.  END IF
  247.  
  248.  IF Choice$ = CHR$(13) THEN Choice$ = K$(Choice): GOTO TDone
  249.  IF (Choice$ = CHR$(27)) AND Escapable THEN
  250.    TLine$ = "ESC"
  251.    GOTO TDone
  252.  END IF
  253.  Choice$ = UCASE$(Choice$)
  254.  FOR I = 1 TO Choices%
  255.    IF Choice$ = K$(I) THEN Choice = I:GOTO TDone
  256.  NEXT
  257.  
  258. TError:
  259.  
  260.  PLAY "O1 MS E64 C32"
  261.  GOTO TGetChoice
  262.  
  263. TLeftArrow:
  264.    DECR Choice
  265.    IF Choice < 1 THEN Choice = Choices%
  266.    RETURN TDisp
  267.  
  268. TRightArrow:
  269.    INCR Choice
  270.    IF Choice > Choices% THEN Choice = 1
  271.    RETURN TDisp
  272.  
  273. TDone:
  274.   TimeOut = TimeUp
  275.   Att = 0: GOSUB TPrint
  276.   IF TLine$ = "" THEN TLine$ = RTRIM$ (LTRIM$ (I$ (Choice)))
  277.  
  278.   IF UsingButtons THEN '                                        erase buttons
  279.      COLOR ScrColor MOD 16, ScrColor \ 16
  280.      LOCATE TopOfButtons
  281.      FOR Ct = 1 TO 5: PRINT SPACE$(80);: NEXT
  282.   END IF
  283.  
  284.   COLOR BLAtt MOD 16, BLAtt \ 16
  285.   LOCATE 25, 1, 1
  286.   PRINT SPACE$ (80);
  287.   EXIT SUB
  288.  
  289. TPrint:
  290.  LOCATE Lines%-1,1
  291. '                          IF Choice < 1 OR Choice > Choices% THEN Choice = 1
  292.  FOR I% = 1 TO Choices%
  293.    IF I% = Choice THEN
  294.      COLOR Att + (BarColor MOD 16), BarColor \ 16
  295.    ELSE
  296.      COLOR MenuColor MOD 16, MenuColor \ 16
  297.    END IF
  298.    PRINT I$(I%);
  299.  NEXT
  300.  RETURN
  301.  
  302.  END SUB                                                    REM TOPMENU
  303.  
  304. ' ==============================================================================
  305.  
  306. SUB POPMENU (TopKey$,MenuRight,MenuDown,Choice,MLine$,MCode$) PUBLIC
  307. '   ====
  308.  
  309.  LOCAL Choices%, D$,A$, Maxx, Title$, MKeyPressed$, PopRead$ ()
  310.  DIM DYNAMIC PopRead$ (24)
  311.  
  312.  
  313. MReadlines:
  314.  
  315.  Choices% = 0: A$ = ""
  316.  
  317.  READ D$ '                   read 2 $'s- the menu line & the assoc. memo
  318.  
  319.  DO WHILE D$ <> "END" AND A$ <> "END" '                     (from data list)
  320.    READ A$
  321.    IF Choices% < 24 THEN INCR Choices% '                          count 1 item
  322.    PopRead$(Choices%) = D$
  323.    IF TopKey$ <> "" THEN PopRead$(Choices%) = "  " + PopRead$(Choices%)
  324.    MenuHelpLine$(Choices%) = A$                          '     plug arrays --
  325.    READ D$ '                                                 ... longest $ is
  326.  LOOP
  327.  PopRead$ (Choices% + 1) = "END"
  328.  
  329.  Title$ = MLine$
  330.  
  331.        CALL SUPERMENU (PopRead$ (), MenuRight, MenuDown, Choice, Title$, Ky%)
  332.  
  333.  MCode$ = MenuHelpLine$(Choice)
  334.  MLine$ = PopRead$ (Choice)
  335.  ERASE PopRead$
  336.  
  337. END SUB                                                           REM POPMENU
  338. '______________________________________________________________________________
  339.  
  340. SUB SUPERMENU (MenuData$ (), MenuRight, MenuDown, Choice, Title$, Ky%) PUBLIC
  341. '   ====
  342. '
  343. '                               ===================
  344. '
  345. '     BRIEF SYNTAX:   MenuData$ () ARRAY holds items in menu
  346. '
  347. '          ferexample, MenuData$ (1) = "L LOAD" (pressing L will select)
  348. '                or ... MenuData$ (1) = "  LOAD" (pressing 1 will select)
  349. '
  350. '           After all menu lines are defined, the next array item must be "END"
  351. '
  352. '                     MenuRight may be >0 for right of center, <0 for left.
  353. '                     MenuDown = 0 places menu at screen top; >24 centers it.
  354. '
  355. '                     Choice is usually set as 1 before calling menu
  356. '
  357. '                     Title$ is just a menu title
  358. '
  359. '
  360. '
  361. '*** AFTER SUPERMENU CALL: Choice will hold the choice # (according to array passed)
  362. '
  363. '                     Ky% will encode the key used to exit the menu process --
  364. '                       %CR, %Esc, %PgUp, %PgDn, %RArrow, %LArrow, %F1, %F2
  365. '
  366. '        (PgUp key will only function if the global var UsePgUp = %Yes, and
  367. '         similarly for the others. If there is another page, cursoring or
  368. '         mousing past the bottom of the displayed page will simulate
  369. '         pressing PgDn, etc. All these globals are reset to %False after exit,
  370. '         but UseF1 isn't.
  371. '
  372.  
  373.  
  374.  
  375.  LOCAL Choices%, D$, A$, K$(), Longest, HelpLines, TopKey
  376.  LOCAL Wid, Height, K$, CornerLin, CornerCol, N, C
  377.  DIM K$ (24)
  378.  Ky% = 0
  379.  
  380.  
  381. '      ======= START; GET WIDTH OF ITEMS AND HOW MANY ===============
  382.  
  383.  LOCATE ,,0
  384.  ArrayNum = 1
  385.  DO UNTIL UCASE$ (RTRIM$ (LTRIM$ (MenuData$(ArrayNum) ))) =  "END"
  386.    INCR Choices%
  387.    IF LEN (RTRIM$ (MenuData$(ArrayNum))) > Longest THEN_
  388.                       Longest = LEN (RTRIM$ (MenuData$(ArrayNum)))
  389.      'keep track of how long the items are ...
  390.    K$ (ArrayNum) = LEFT$ (MenuData$ (ArrayNum), 1)
  391.    IF MenuHelpLine$ (ArrayNum) <> "" THEN INCR HelpLines
  392.    INCR ArrayNum
  393.  LOOP
  394.  DECR Longest, 2  '          clip off the 2 chrs which are not part of the item
  395.  
  396. '      ==================== DO CALCULATIONS FOR MENU ===========================
  397. MSetVars:
  398.  
  399.  VCentered = (MenuDown > 23) '                           trap hi MenuDown value
  400.  Wid = MAX ((Longest + 6), 9) '                            compute box size --
  401.  Height = Choices%+2
  402.  MenuDown = MAX% (0, MenuDown)
  403.  MenuDown = MIN% ((23-Choices%), MenuDown)
  404.  MenuRight = MIN% ((40 - Wid\2), MenuRight)
  405.  MenuRight = MAX% (-39, MenuRight)
  406.  CornerCol = INT((80-Wid)/2 + MenuRight)'            & the top left corner --
  407.  CornerCol = MAX% (1, CornerCol)
  408.  CornerLin = INT(1 + MenuDown)
  409.  IF VCentered THEN CornerLin = (24-Height)/2 + 1 '  trap hi MenuDown value
  410.  CornerLin = MAX% (1, CornerLin)
  411.  IF TopKey$ <> "" THEN TopKey = ASC(TopKey$)'         (means center vertically)
  412.  BAR$ = "\"+SPACE$(Wid-8)+"\"
  413.  Choice = MAX% (1, Choice)
  414.  Choice = MIN% (Choices% , Choice)
  415.  IF LEFT$ (MenuData$ (1), 1) = " " THEN
  416.    IF Choices% > 9 THEN TopKey = ASCII ("A") ELSE TopKey = ASCII ("1")
  417.  END IF
  418.  
  419. MPrint:
  420.  
  421.  L0 = CSRLIN: C0 = POS
  422.  COLOR MenuColor MOD 16, MenuColor \ 16
  423.  
  424. '      =================== BEGIN PRINTING MENU =====================
  425.  
  426.  LOCATE CornerLin,CornerCol: PRINT CHR$(201); STRING$((Wid-1),205); CHR$(187)
  427.  IF Title$ <> "" THEN LOCATE CornerLin,CornerCol+2: PRINT " ";Title$;" "
  428. '                                                top of menu frame is complete
  429.  
  430.  '                                                             print menu lines
  431.  FOR N = 1 TO Choices%
  432.    IF TopKey > 0 THEN K$ (N) = CHR$(TopKey-1+N)
  433.    LOCATE N+CornerLin, CornerCol
  434.    PRINT CHR$(186); " "; K$(N); " - ";
  435.    PRINT USING BAR$; MID$(MenuData$(N),3); : PRINT CHR$(186);
  436.  NEXT
  437.  '                                                             print bottom bar
  438.  LOCATE N+CornerLin,CornerCol:PRINT CHR$(200); STRING$((Wid-1),205); CHR$(188);
  439.  
  440.  CALL  GetMouse: MCol0 = MouseCol: MLin0 = MouseLin
  441.  
  442.  LBPresses = 0: LBReleases = 0
  443.  GOSUB DrawHighlightedBar
  444.  
  445. MGetChoice:
  446.  
  447.  DO '                                         ********************************
  448. '                                            ** GET KEYSTROKE OR MOUSE INPUT **
  449. '                                             ********************************
  450.    Choice$ = ""
  451.    DO
  452.      IF NeedDCon THEN
  453.  
  454.        CALL GetMouse '                              (a better mousetrap ...)
  455.  
  456.        IF  LBPresses = 1 THEN '                        Here you may select your
  457.   REM                 IF  LBReleases = 1 THEN'         preferred mouse method.
  458.   REM                 IF  LBReleases = 2 THEN'         You can have your choice
  459.          Choice$ = CHR$(13) '                          on the first left-button
  460.          EXIT LOOP '                                   release after entry, or
  461.        ELSEIF RightButtonPressed THEN '                the first click, the 2nd
  462.          Choice$ = CHR$(27) '                          release -- U name it !!
  463.          EXIT LOOP
  464.        END IF
  465.  
  466.        IF MouseLin < Choice + 1 THEN '                     mouse has moved up
  467.          Choice = MouseLin
  468.          Choice$ = CHR$ (00, &H48)          '                     UpArrow
  469.          EXIT LOOP
  470.        ELSEIF MouseLin > Choice + 1 THEN '               mouse has moved down
  471.          Choice = MouseLin - 2
  472.          Choice$ = CHR$ (00, &H50)          '                     DownArrow
  473.          IF MouseLin > Choices% + 1 THEN
  474.            CALL Mouse (%SetRodent, 0, 8 * MouseCol, (1 + Choices%) * 8)
  475.          END IF
  476.          EXIT LOOP
  477.        END IF
  478.  
  479.        IF MouseCol < 26 THEN Choice$ = CHR$ (00, &H4B): EXIT LOOP ' L. Arrow
  480.        IF MouseCol > 37 THEN Choice$ = CHR$ (00, &H4D): EXIT LOOP ' R. Arrow
  481.  
  482.        IF Choice$ = "" THEN Choice$ = UCASE$ (INKEY$)
  483.      ELSE
  484.        Choice$ = UCASE$(INKEY$)
  485.      END IF
  486.      OldChoice = Choice
  487.    LOOP UNTIL Choice$ <> ""
  488.  
  489.  '                  ======================== CHOICE HAS BEEN MADE ...
  490.  
  491.    SELECT CASE Choice$
  492.          CASE CHR$ (0 ) + CHR$(&H48 )
  493.            GOSUB MUpArrow
  494.          CASE CHR$ (0 ) + CHR$(&H50 )
  495.            GOSUB MDownArrow
  496.          CASE CHR$ (0 ) + CHR$(&H4B )
  497.            IF UseLArrow THEN GOSUB MLArrow
  498.          CASE CHR$ (0 ) + CHR$(&H4D )
  499.            IF UseRArrow THEN GOSUB MRArrow
  500.          CASE CHR$ (0 ) + CHR$(&H3B )
  501.            GOSUB MF1Key
  502. '                 deleted       CASE CHR$ (0 ) + CHR$(&H3C )
  503. '                 deleted         GOSUB MF2Key
  504.          CASE CHR$ (0 ) + CHR$(&H49 )
  505.            IF UsePgUp THEN GOSUB MPgUpKey
  506.          CASE CHR$ (0 ) + CHR$(&H51 )
  507.            IF UsePgDn THEN GOSUB MPgDnKey
  508.          CASE CHR$(13)
  509.             Choice$ = K$(Choice) '                    you pressed [CR]
  510.  
  511.          CASE CHR$(27)'     you pressed [ESC]. Sets return var as 0 and exits.
  512.             Choice = 0
  513.             Ky% = %Esc
  514.             EXIT LOOP ' --------------------------------------------------------
  515.    END SELECT
  516.  
  517. '                                                              & chose Choice$
  518. '                Your entry is checked vs. list of K$'s,  If it's valid
  519. '                                             then Choice is set appropriately.
  520.      FOR I = 1 TO Choices%
  521.        IF Choice$ = K$(I) THEN Choice = I: EXIT LOOP
  522.      NEXT
  523.  
  524.  LOOP
  525.  
  526. ExitMenu:
  527.  '                   IF Choice > 0 THEN
  528.  GOSUB MoveBar
  529.  MenuDown = 0: MenuRight = 0
  530.  UsePgUp = 0: UsePgDn = 0: UseRArrow = 0: UseLArrow = 0: PullDown = 0
  531.  FOR N = 1 TO Choices%: MenuHelpLine$(N) = "": NEXT
  532.  Call Mouse (%SetRodent, 0, MCol0 * 8, MLin0 * 8)
  533.  LOCATE L0,C0,1
  534.  EXIT SUB
  535.  
  536.  
  537.  
  538. MoveBar:
  539.  
  540.    COLOR MenuColor MOD 16, MenuColor \ 16 '                 NOTE: THIS IS ONE
  541.    LOCATE (OldChoice+CornerLin),(CornerCol+1) '             OF THOSE DREADED
  542.    PRINT " ";K$(OldChoice);" - "; '                         TWO-HEADED SUB-
  543.    PRINT USING BAR$;MID$(MenuData$(OldChoice),3); '         ROUTINES. MoveBar
  544. '                                                           RUNS RIGHT INTO
  545. DrawHighlightedBar: '                                       DrawHighLightedBar!
  546.    IF HelpLines THEN GOSUB ClearLine25 '                   (works just Fine!)
  547.    IF Choice > Choices% THEN Choice = Choices%
  548.    IF Choice THEN
  549.      COLOR BarColor MOD 16, BarColor \ 16 '                  if Choice = 0
  550.      LOCATE (Choice + CornerLin),(CornerCol+1) '             you end up without
  551.      PRINT " ";K$(Choice);" - "; '                           a highlighted bar
  552.      PRINT USING BAR$;MID$(MenuData$(Choice),3);
  553.                                                  ''  print bottom line on screen
  554.      IF LEN(MenuHelpLine$(Choice)) > 9 THEN
  555.          MenuHelpLine$(Choice) = Left$(MenuHelpLine$(Choice), 78)  ' trap long ln
  556.          COLOR MenuColor MOD 16, MenuColor \ 16
  557.          LOCATE 25, (41-LEN(MenuHelpLine$(Choice))/2)
  558.          PRINT MenuHelpLine$(Choice);
  559.      END IF
  560.    END IF
  561.    CALL Mouse (%SetRodent, 0, 240, (1 + Choice) * 8)
  562.    RETURN
  563.  
  564. MUpArrow:
  565.    DECR Choice
  566.    IF Choice < 1 THEN
  567.      IF PullDown THEN
  568.        Ky% = %Esc
  569.        RETURN ExitMenu
  570.      ELSEIF UsePgUp THEN
  571.        Ky% = %PgUp
  572.        Choice = 0
  573.        RETURN ExitMenu
  574.      ELSE
  575.        Choice = Choices%
  576.      END IF
  577.    END IF
  578.    GOSUB MoveBar: RETURN
  579.  
  580. MDownArrow:
  581.    INCR Choice
  582.    IF Choice > Choices% THEN
  583.      IF PullDown THEN
  584.        DECR Choice
  585.      ELSEIF UsePgDn THEN
  586.        Choice = 0
  587.        Ky% = %PgDn
  588.        RETURN ExitMenu
  589.      ELSE
  590.        Choice = 1
  591.      END IF
  592. '                               IF PullDown THEN DECR Choice ELSE Choice = 1
  593.    END IF
  594.    GOSUB MoveBar: RETURN
  595.  
  596. MF1Key:
  597.    Ky% = %F1
  598.    Choice = 0 '                  just as if ESC had been pressed
  599.    RETURN ExitMenu
  600.  
  601. MF2Key:
  602.    Ky% = %F2
  603.    RETURN ExitMenu
  604.  
  605. MPgUpKey:
  606.    Ky% = %PgUp
  607.    Choice = 0
  608.    RETURN ExitMenu
  609.  
  610. MPgDnKey:
  611.    Ky% = %PgDn
  612.    Choice = 0
  613.    RETURN ExitMenu
  614.  
  615. MRArrow:
  616.    Ky% = %RArrow
  617.    RETURN ExitMenu
  618.  
  619. MLArrow:
  620.    Ky% = %LArrow
  621.    RETURN ExitMenu
  622.  
  623. ClearLine25:
  624.    LOCATE 25,1
  625.    PRINT STRING$ (80," ");
  626.    RETURN
  627.  
  628.  '       -------------------------------------------------
  629.  
  630.  END SUB                                                         REM SUPERMENU
  631.